perm filename ALPHA.OLD[P11,LCS] blob
sn#581886 filedate 1981-04-28 generic text, type T, neo UTF8
C****** FOR LISTS OF LETTERS, ETC. AND TRILL *******
SUBROUTINE ALPHA
INTEGER FNAME,POS
DIMENSION FNAME(4)
COMMON /PLTR/IPLT,RHT,DIS /FONT/JFONT /NFONT/NFONT
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
COMMON/ALF/INP(10),OLDX /OLDTOP/OLDY
EQUIVALENCE(J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),
1(R8,RJQ(6)),(NRJ,RJQ(8)),(JX,JQ(11)),
1(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
1,(J6,JQ(4)),(R7,RJQ(5)),(R4,RJQ(2)),(IFNT,JQ(13)),(J11,JQ(9)),
1(RY,JQ(16)),(RX,JQ(17)),(RZ,JQ(18)),(RW
1,JQ(19)),(RB,JQ(20)),(R,RJQ(20)),(FILL,RJQ(19)),(R9,RJQ(7))
1,(JTR,RJQ(17)),(RF,RJQ(15)),(JR3,RJQ(14)),(R3,RJQ(1))
1,(R10,RJQ(8)),(R11,RJQ(9)),(R12,RJQ(10))
COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,POS
DATA R4X/-2.1/,IFNT/1/,BLANK/0.7/,NFONT/'BDR40'/
1,FNAME/'PRIM0','BDR40','BDI40','BDL40'/
C SEE NEW SIZE FOR 'BLANK'=.7 (OLD SIZE=1.0, CHANGE IN DDT IF NECESSARY)
IF(JA.EQ.7)GO TO 20
JTR=99
IF(R5.GE.100)R5=R5-100
C >100 FOR TEXT IN ORCH SCORES FOR ALL SEP. PARTS.
C PRIMITIVE IS DEFAULT FONT. #=SET BACK TO PRIM.
C ONLY 11 LETTERS WITHOUT FONT RESET.
JF=-JFONT
IF(JFONT.GE.0)GO TO 540
JFONT=1
NFONT=FNAME(JF)
GO TO 54
540 IF(NFONT.EQ.'PRIM0')GO TO 54
IF(NFONT.EQ.'BDI40')GO TO 54
NFONT='BDR40'
C THE ABOVE IN CASE FONT IS NOT ESTABLISHED.
54 R=19.7*R5*RSTJ2
RB=J3
RW=R4
J9=0
C J9=0 AVOIDS ROTATION IN 'CLEFS'
DO 50 KA=4,6
NXZ=-1
RZ=RJQ(KA)
CC JY=RZ
CC IF(JY.NE.RZ)GO TO 130
CC IF(JY.EQ.RZ)GO TO 13
C WILL LOSE ON "0AB0" IN OLD FILES**************
CC IF(JY.GT.999999)GO TO 13
CC130 RZ=100.*RZ
C FOR OLD FORMAT OF CODE 16
13 JY=RZ+.2
JX=1000000
DO 53 LA=1,4
J5=JY/JX
J5X=J5
R3=J3
IF(J5.EQ.99)GO TO 55
73 IF(KFNT)IFNT=1
C READS OLD SYS. AND NEW AUTOMATIC LWR CASE.
IF(J5.LT.70)GO TO 72
KFNT=-1
C SETS AUTOMATIC LOWER CASE FLAG.
IFNT=-1
C 60 ADDED FOR LOWER CASE LETTERS.
J5=J5-60
C NO MORE IN THIS WD.
72 IF(J5.LT.48)GO TO 1
IF(J5.NE.48)GO TO 172
NFONT='BDL40'
IF(JFONT.LT.0)GO TO 9
GO TO 11
172 GO TO(2,3,9,4,5),J5-49
C SWITCHES FOR DIFF. FONTS.(55 MAKES ')48=UPR,49=LWR,50=BDR,51=BDI,52=PRM
C ********* UPPER AND LOWER NUMBERS(48,49) NO LONGER NEEDED.(SEE 73 ↑)
IF(J5.GT.55)GO TO 10
J5=36
R4=R4+2.9*R5
C 55 WILL MAKE ' --- 56=? 57=! (THEY COME AFTER y z IN BDR46)
GO TO 1
10 J5=J5+6
NRX=NFONT
NXZ=0
NFONT='BDR40'
NJF=JFONT
JFONT=-1
GO TO 1
2 NFONT='BDR40'
C &=NON-ITALICS -- JFONT IS TEMPORARY SWITCH 5/74
IF(JFONT.LT.0)GO TO 9
GO TO 11
CC GO TO 8
3 NFONT='BDI40'
C @=51=ITALICS
IF(JFONT.LT.0)GO TO 9
C TYPE '44 -1' TO MAKE ALL FONTS INTO 'PRIM'
CC8 IF(IFNT.EQ.0)IFNT=-1
GO TO 11
4 FILL=-2
GO TO 11
5 FILL=0
GO TO 11
9 NFONT='PRIM0'
GO TO 11
1 IF(J5.LT.70)GO TO 12
IF(J5.GE.76)GO TO 12
IF(J5.NE.75)GO TO 112
J5=70
GO TO 12
112 NFONT='BDI40'
J5=J5-6
GO TO 71
12 J5OLD=J5
IF(J5.LT.64)GO TO 212
J5X=J5
IF(J5.LE.65)J5X=J5X-6
IF(J5.EQ.70)J5X=J5X-1
J5=J5X
212 CALL SPACER(J5,IFNT,RB,R)
J5=J5OLD
IF(J5.GT.60)GO TO 71
C NOW 62=? 63=! IN BDR46
IF(J5-47)7,6,11
7 IF(R11.NE.0.AND.R12.EQ.0)GO TO 79
IF(JFONT)78,78,77
79 R9=R11
J9=-1
C FOR ROTATION, IF ANY. R11=ROTATION(CLOCKWISE) IN DEGREES.
GO TO 77
277 IF(NFONT.NE.'PRIM0')GO TO 70
IF(IFNT.GE.0)GO TO 30
IF(J5.GE.10)GO TO 71
GO TO 30
177 J5=J5+22
C (=62 )=63 IN BDI (BDI46)
NRX=NFONT
C SAVE OLD FILE NAME
NFONT='BDI40'
NJF=JFONT
C SAVE FONT FLAG
NXZ=0
C FLAG TO GET BACK RIGHT FLAGS BEFORE 30
GO TO 71
78 IF(IPLT.GE.0)GO TO 30
C JFONT=0 FOR FIXED WIDTH OF FONTS. = AND ONLY DPYS PRIMITIVE.
CC J5=J6
CC IF(IFNT.EQ.0)GO TO 30
CC77 IF(J5.GE.36)GO TO 30
77 IF(J5.LT.36)GO TO 277
IF(J5.EQ.40.OR.J5.EQ.41)GO TO 177
C FOR LEFT AND RIGHT PARENTH.
IF(J5.NE.43)GO TO 30
C ASTERISK
C PUNCTUATION AND SPACE.
IF(NFONT.EQ.'PRIM0')GO TO 30
IF(NFONT.EQ.'BDI40')GO TO 77
NRX=NFONT
NXZ=0
NJF=J5
NFONT='BDI40'
777 J5=69
GO TO 71
CZ IF(IFNT.GE.0)GO TO 30
CC*** WAS (IFNT.EQ.1) ???? 1/76
CZ IF(J5.LT.10)GO TO 30
C JUMP TO USE UPPER CASE PRIM. LOWER CASE STARTS IN PRIM1.
CZ GO TO 71
70 IF(J5.LE.9)GO TO 71
IF(IFNT.LT.0)J5=J5+26
71 RX=R6
R6=R5*.28
C .29 IS SIZE FACTOR -- PERHAPS CHANGE SIZE IN FONT TO =1.
RY=R7
R7=R6
RZ=R8
R4=R4+R4X
C SHIFTS DOWN ??? WHY NOT GET RID OF THIS.??
J8=FILL
NRJ=NFONT
C GETS RIGHT FILE
R8=0
C TO AVOID THICKENER IN 'CLEFS'
JA=12
C ANY NON-11 NUMBER .GT.10 WILL DO.
CALL CLEFS
R6=RX
R7=RY
R8=RZ
C PUTS BACK RIGHT STUFF
IF(NXZ.LT.0)GO TO 6
NFONT=NRX
JFONT=NJF
GO TO 6
30 J7=0
R6=R5
CALL PNUM
C 47=BLANK (WAS 99)
6 J3=ROFF(RB)
R4=RW
11 JY=JY-J5X*JX
C TO GET NEXT NUM OUT OF JY
53 JX=JX/100
50 CONTINUE
55 IF(JTR.NE.99)GO TO 52
NSAV=NFONT
GO TO 100
C FOR TRILLS
C 7, POS1, STF, NT#, SIZE, POS2, X IF X=1 THEN NO WAVEY LINE
20 RF=R6
NSAV=NFONT
C SAVE THE FONT NAME. GET IT BACK AT END.
JTRILL=J7
IF(J7.LE.1)GO TO 200
IF(J7.GE.8)GO TO 201
C JUMP FOR OTTAVA
C NEXT FOR SPECIAL PEDAL MARKS.
C PEDAL: 7,STF,POS,0=STND POS,NNN=PEDS,POS2,BRACK #S,LFT POS BRK.
C P5=101 MEANS LFT & RT PEDS., P7=2 NO BRK, =3 --!, =4 ----
RW=R8
RB=R3
NFONT=J7
JY=J5
CALL NOZERO(R9)
RY=R9
RX=23.84*R9*RSTJ2
R6=.45*RY
J9=0
J5=18
C IN FILE CLEF1.DMD
JA=3
R5=0
R7=0
R4=R4-6
C STANDARD POS IS AT -6 ****** (I.E. P4=0 PUTS TOP OF IT AT -6)
CALL CLEFS
R8=0
IF(JY.EQ.0)GO TO 222
R8=-1
J5=19
IF(JY.LT.100)GO TO 203
JY=JY-100
CALL CLEFS
203 R3=RB+RX
IF(JY.LT.10)GO TO 204
JY=JY-10
CALL CLEFS
204 R3=RB+RX+RX
IF(JY.NE.0)CALL CLEFS
C PRINTS THE 3 BOTTOM ITEMS
222 IF(NFONT.EQ.2)GO TO 2222
IF(RW.NE.0)R3=RB-5.96*RW
C FOR BRACKET
RX=POS
R6=RF
R4=R4+3.
R5=R4
J7=0
R7=0
R8=0
R10=0
206 CALL ITMSUB
IF(NFONT.EQ.4)GO TO 2222
C R7=4= NO END ON BRKT.
IF(NFONT.EQ.5)GO TO 2206
OLDY=10.*RY*RSTJ2
C THIS WILL BE VERTICAL PART OF BRACK. END.
C THE COORD. FROM LAST LINES CALL
CALL LINES(OLDX,OLDY,2)
C OLDX WAS LAST X COORD. IN ITMSUB **************
GO TO 2222
CZ POS=RX
C POS GOT RUINED IN ITMSUB.
CZ R3=ROFF(RHORZ(RF))
CZ R5=R5+1.4*RY
CZ CALL ITMSUB
CZ RETURN
2206 RARR=2.25*RY*RSTJ2
R4=R4+2.12
JA=4
J5=50
C FOR CRESC.
RYY=1.29*RY
R6=RF
R3=(R6-RARR)*5.96-596.
R7=-RYY
CALL ITMSUB
C GO DRAW CRESC.
GO TO 2222
C NEXT FOR 8VA BASSA
202 R7=47717088.
R8=88709999.
RR10=138.
R6=51089170.
GO TO 214
201 CALL NOZERO(R5)
IF(J7.EQ.15)GO TO 205
R6=51089170.
C NEXT = 8VA
RR10=47.
R7=99999999.0
214 RR5=R5*RSTJ2
RR3=R3+RR10*RR5
C SAVE FOR POS. OF DASHES
JTR=-1
J4=J7
J10=J8
C SAVE THESE IN PARAMS NOT USED IN ALPHA
GO TO 2212
C 15MA - - - - -
205 R6=51010582.
R7=70999999.
RR10=56.
GO TO 214
C NEXT FOR THE DASHES. J8=1 =NO END BRACK.
213 R8=1.8*RR5
R9=0
R3=RR3
R6=RF
R4=R4+.7*RSTJ2
R5=R4
J5=J4
J11=-1
IF(J4)J11=-J11
IF(J10.NE.0)J11=0
J7=1
J10=0
C GO DRAW THE DASHES
CALL ITMSUB
GO TO 2222
200 CALL NOZERO(R5)
IF(J7.EQ.-8)GO TO 202
RR10=R5
C ↑↑↑↑↑ R10 GETS WIPED OUT IN ALPHA OR CLEFS.
J3=J3+6.*RSTJ2
JR3=J3
R6=51898799.0
C @tr LWR CASE, ITAL. TR
R7=0
R8=R7
JTR=J7
2212 R5=.8*R5
GO TO 54
52 J5=R8
C FOR ACCI OVER TR
K=POS
C SAVE POS IN K FOR ACCI ROUTINE
IF(JTR.NE.0)GO TO 1000
C GO TO 100 IF NO WAVY LINE IS NEEDED. J7=1=NO, 0=YES
R3=JR3+20.*RSTJ2*RR10
JA=4
J7=-2
C J7 IS SWITCH TO DRAW WIGGLE
R6=RF
R9=.7*RR10
C SETS WIGGLE HEIGHT
R8=.9*RR10
C RR10 IS SIZE (P5)
J10=0
IF(IPLT.LT.0)J10=1
CALL ITMSUB
C SINGLE WIGGLE ON DPY, DOUBLE ON PLOTTER.
1000 IF(JTRILL.LT.0.OR.JTRILL.GT.1)GO TO 100
C NEXT PUTS ACCI OVER TR IF 1, 2 OR 3 IN P8
C IF JTRILL(J7)=0 OF 1 IT'S A TRILL, ELSE GO TO 2222
C IF R8=0 GOTO 2222 (R8 HAS ACCI NUM)
IF(R8.EQ.0)GO TO 100
POS=K
C GET BACK POS. (IT GOT CHANGED IN "WIGGLE")
CENTR=CENTR+27.*RSTJ2
R6=R5*.9
R3=J3-14.*RSTJ2
R4=R4+3.75
R7=0
R8=0
R9=0
JA=9
C NOW GO MAKE AN ACCI.
CALL NOTWRT
100 IF(JTR.LT.0)GO TO 213
IF(KFNT.LT.0)IFNT=1
KFNT=0
2222 NFONT=NSAV
C GET BACK ORIGINAL FONT NAME
END